home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / prog / m2menu.zip / MENUIO.MOD < prev    next >
Text File  |  1990-03-22  |  3KB  |  107 lines
  1. IMPLEMENTATION MODULE MenuIO; (* JPI TopSpeed Modula-2 V1.16 *)
  2.  
  3.  IMPORT AsmLib, Lib, Storage, Str, SYSTEM;
  4.  
  5.  PROCEDURE Delay(n:CARDINAL);
  6.  CONST Delay = AsmLib.Delay;
  7.  BEGIN
  8.    Delay(n)
  9.  END Delay;
  10.  
  11.  (* Delay pauses program a CARDINAL value of milliseconds. 1000 = 1 sec. *)
  12.  
  13.  
  14.  PROCEDURE EnvFind(name:ARRAY OF CHAR; VAR result:ARRAY OF CHAR);
  15.  VAR n : CARDINAL;
  16.     pi : ARRAY[0..14] OF CHAR;
  17.     es : ARRAY[0..80] OF CHAR;
  18.     pp : Lib.CommandType;
  19.  BEGIN
  20.    n := 0;
  21.    LOOP
  22.      pp := Lib.Environment(n);
  23.      Str.Copy(es,pp^);
  24.        IF es[0] = CHR(0) THEN
  25.          result[0] := CHR(0);
  26.          RETURN
  27.        END;(*IF*)
  28.        Str.ItemS(pi,es,' =',0);
  29.        IF Str.Match(pi,name) THEN
  30.          Str.ItemS(result,es,' =',1);
  31.          RETURN
  32.        END;(*IF*)
  33.      INC(n)
  34.    END;(*LOOP*)
  35.  END EnvFind;
  36.  
  37.  (* EnvFind finds a string in the DOS environment *)
  38.  
  39.  
  40.  PROCEDURE Exec (command:ARRAY OF CHAR; params:ARRAY OF CHAR);
  41.  VAR memptr  : ADDRESS;
  42.      memsize : CARDINAL;
  43.      reply   : CARDINAL;
  44.  BEGIN
  45.    memsize := Storage.HeapAvail ( Storage.MainHeap )-8; 
  46.    (* 8 for MSDOS relocation *)
  47.    
  48.    Storage.HeapAllocate(Storage.MainHeap,memptr,memsize);
  49.    reply := Lib.Execute(command,params,memptr,memsize);
  50.    Storage.HeapDeallocate(Storage.MainHeap,memptr,memsize);
  51.    IF reply <> 0 THEN
  52.      Lib.FatalError('Failed to execute program ')
  53.    END;(*IF*)
  54.  END Exec;
  55.  
  56.  (* Exec executes a named program, using all free heap memory to do so. *)
  57.  (* All memory allocation/deallocation is automatic. Include ext & Path *)
  58.  (* eg Exec('\COM\ED.EXE','AFILE'); will be passed as the 'command line'*)
  59.  
  60.  
  61.  PROCEDURE ExecCmd(command:ARRAY OF CHAR);
  62.  VAR
  63.    path  : ARRAY[0..63 ] OF CHAR;
  64.    cline : ARRAY[0..128] OF CHAR;
  65.  BEGIN
  66.    EnvFind('COMSPEC',path);
  67.    Str.Concat(cline,'/C ',command);
  68.    Exec(path,cline)
  69.  END ExecCmd;
  70.  
  71.  (* ExecCmd is similar to Exec except the command is executed under *)
  72.  (* COMMAND.COM, the DOS command interpreter. This means that the   *)
  73.  (* command can be exactly as typed from the normal DOS prompt, and *)
  74.  (* may include 'built in' commands such as DIR, COPY etc.          *)
  75.  (* Examples: ExecCmd('dir /w');   (* do a 'wide' DOS directory *)  *)
  76.  (*           ExecCmd('ed afile'); (* same as Exec example above *) *)
  77.  (* ExecCmd is generally preferred over Exec for general use        *)
  78.  (* although it has two disadvantages:                              *)
  79.  (* 1) There is slightly less memory available to run the command,  *)
  80.  (* 2) COMMAND.COM must be re-loaded which is slightly slower.      *)
  81.  
  82.  
  83.  PROCEDURE GetKey(VAR sc:CHAR): CHAR;
  84.  VAR r:SYSTEM.Registers;
  85.  BEGIN
  86.    WITH r DO
  87.      AH := 0;
  88.      Lib.Intr(r,16H);
  89.      IF AH # 0 THEN
  90.        sc := CHR(AH)
  91.      ELSE
  92.        sc := CHR(AH-128)
  93.      END(*IF*);
  94.    IF sc > CHR(127) THEN
  95.      AL := AH
  96.    END(*IF*);
  97.      IF AL # 0 THEN
  98.        RETURN CHR(AL)
  99.      ELSE
  100.        RETURN CHR(AH+128)
  101.      END(*IF*);
  102.    END(*WITH*)
  103.  END GetKey;
  104.  
  105.  (* GetKey returns Char and scan code *)
  106.  
  107. END MenuIO.